home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Fonts / PostScript® Samples / LaserText < prev    next >
Encoding:
Text File  |  1986-11-11  |  33.9 KB  |  962 lines  |  [TEXT/ttxt]
  1. %!
  2. %
  3. %-----------------------------------------------------------------------------------------
  4. % This is the PostScript™ LaserWriter Header
  5. % Not all procedures are documented.  Some are self explanatory    for users at all familiar
  6. % with PostScript.  Others are not particularly    significant.  Most of these procedures
  7. % are defined into a global dictionary as    they are encountered, while others are executed
  8. % immediately and serve    to set global state for    later print jobs.
  9. % The documentation for    these procedures amounts to a few words    of description usually
  10. % followed by a colon and the parameters    that the procedure takes.  Any values the
  11. % procedure leaves on the stack are then described if appropriate.  e.g.
  12. %
  13. % Description:    parameter1 parameter2 ... parametern
  14. % Description of any values left on stack
  15. %
  16. % This documentation is    not intended to    be either exhaustive or    totally    definitive
  17. % but is provided as a guide and reference source.
  18. % The    names used herein    are defined as PostScript names and should not    be redefined
  19. % or reused for    other purposes by clients who are defining their own PostScript    code.
  20. % In most cases    names have been    used which are two and three characters    in length
  21. % so it    is usually safe    for clients to use names
  22. % that are more    than three characters.    At some    future time all    names may be
  23. % redefined to be no longer than three characters so that developers may use 4 or more
  24. % characters without hesitation.
  25. %-----------------------------------------------------------------------------------------
  26.  
  27. %-----------------------------------------------------------------------------------------
  28. % This is the LaserWriter password constant.  It constitutes the first string in the LaserPrep string
  29. % list resource.  Clients who wish to change their password on the LaserWriter printer may make    the
  30. % header compatible by changing    this string appropriately.  Its    length is 7 characters so that it may
  31. % accommodate passwords    up to 7    characters without need    to change the length of    the string or resource.
  32. %-----------------------------------------------------------------------------------------
  33. 0000000
  34.  
  35. %-----------------------------------------------------------------------------------------
  36. %This is the Apple header version number
  37. %-----------------------------------------------------------------------------------------
  38. %{appledict version #13
  39.  
  40. %serverdict begin exitserver
  41. %systemdict /statusdict known{statusdict    begin 9    0 3 setsccinteractive /waittimeout 300 def end}if
  42. /md 200    dict def md begin
  43.  
  44. %-----------------------------------------------------------------------------------------
  45. %This is the Apple header version number defined in PostScript
  46. %-----------------------------------------------------------------------------------------
  47. /av 13 def
  48.  
  49. /mtx matrix currentmatrix def
  50. /s30 30    string def
  51. /s1 ( )    def
  52. /pys 1 def
  53. /pxs 1 def
  54. /pyt 760 def
  55. /pxt 29.52 def
  56. /por true def
  57. /xl{translate}def
  58. /fp{pnsh 0 ne pnsv 0 ne    and}def
  59.  
  60. %-----------------------------------------------------------------------------------------
  61. % This array describes the QuickDraw verbs in PostScript.  In Pascal these correspond to:
  62. %    GrafVerb =    (frame,    paint, erase, invert, fill);
  63. % and are defined in that order    with a few additional verbs that are used internally.
  64. % Note that invert is illegal in Postscript and    doesn't    really do anything.
  65. %-----------------------------------------------------------------------------------------
  66. /vrb [
  67. {fp{gsave 1 setlinewidth pnsh pnsv scale stroke    grestore}if newpath}
  68. {eofill}
  69. dup
  70. {newpath}
  71. 2 index
  72. dup
  73. {initclip eoclip newpath}
  74. {}
  75. dup
  76. 2 copy
  77. ] def
  78.  
  79. /xdf{exch def}def
  80. currentscreen /spf xdf /rot xdf    /freq xdf
  81.  
  82. %-----------------------------------------------------------------------------------------
  83. % This procedure, called with the ordinal value    of the QuickDraw verb on the PostScript
  84. % stack, executes the appropriate verb procedure in /vrb.
  85. %-----------------------------------------------------------------------------------------
  86. /doop {vrb exch    get exec} def
  87.  
  88. %-----------------------------------------------------------------------------------------
  89. % This procedure takes a portrait landscape flag, x and    y translation coordinates, x and y scale
  90. % factors, and x and y resolution parameters.  It doesn't alter    the current PostScript state yet.
  91. %-----------------------------------------------------------------------------------------
  92. /psu{2 index .72 mul exch div /pys xdf div .72 mul /pxs    xdf /pyt xdf /pxt xdf /por xdf}def
  93.  
  94. %-----------------------------------------------------------------------------------------
  95. % Here the actual PostScript state is altered according    to global values set previously.
  96. %-----------------------------------------------------------------------------------------
  97. /txpose{dup 1680 eq userdict /note known{{legal}{note}ifelse}{pop}ifelse
  98. dup 1212 eq{54 32.4 xl}if 1321 eq{8.64 -.6 xl}if
  99. pxs pys    scale pxt pyt xl por not{270 rotate}if 1 -1 scale}def
  100.  
  101. %-----------------------------------------------------------------------------------------
  102. % oblique a font takes pointsize and flag
  103. %-----------------------------------------------------------------------------------------
  104. /obl {{0.212557    mul}{pop 0} ifelse} def
  105.  
  106. %-----------------------------------------------------------------------------------------
  107. % setfont from dictionary: pointsize obliqueflag fontdictionary
  108. % leaves the final font    dictionary on the stack    after doing a setfont
  109. %-----------------------------------------------------------------------------------------
  110. /sfd {[ps 0 ps 6 -1 roll obl ps    neg 0 0] makefont dup setfont} def
  111.  
  112. %-----------------------------------------------------------------------------------------
  113. % set font: obliqueflag    /fontname
  114. %-----------------------------------------------------------------------------------------
  115. /fnt{findfont sfd}def
  116.  
  117. %-----------------------------------------------------------------------------------------
  118. % test bit in an integer:  integer bit-to-test
  119. % returns flag and the original    integer
  120. %-----------------------------------------------------------------------------------------
  121. /bt{1 index and    0 ne exch}def
  122.  
  123. %-----------------------------------------------------------------------------------------
  124. % set style flags from the ordinal value of style
  125. % style    array contains flags for Bold, Italic, Underline, Outline, Shadow.
  126. % The ordinal value of style is    also saved
  127. %-----------------------------------------------------------------------------------------
  128. /sa 6 array def
  129. /fs{1 bt
  130.     2 bt
  131.     4 bt
  132.     8 bt
  133.    16 bt
  134.    sa astore pop
  135. }def
  136.  
  137. /mx1 matrix def
  138. /mx2 matrix def
  139. /gf{currentfont}def
  140.  
  141. %-----------------------------------------------------------------------------------------
  142. % Text munging procedures.
  143. % These    have to    do with    string merging and text    scaling    and rotation.
  144. %-----------------------------------------------------------------------------------------
  145. %-----------------------------------------------------------------------------------------
  146. % set relative center of rotation:
  147. % yintegerpart yfractionpart xintegerpart xfractionpart
  148. %-----------------------------------------------------------------------------------------t
  149. /tc{32768 div add 3 1 roll 32768 div add 2t astore pop}def
  150.  
  151. %-----------------------------------------------------------------------------------------
  152. % set additional rotation parameters: justify flip rotation
  153. % justify is:
  154. %     1       left
  155. %     2       center
  156. %     3       right
  157. %     else full
  158. % flip is:
  159. %     0       none
  160. %     1       flip    around y axis
  161. %     2       flip    around x axis
  162. % rotation is in degrees counterclockwise
  163. %-----------------------------------------------------------------------------------------
  164. /3a [0 0 0] def
  165. /2t 2 array def
  166. /tp{3a astore pop}def
  167.  
  168. /ee{}def
  169.  
  170. %-----------------------------------------------------------------------------------------
  171. % start    rotated    text at    current    penlocation:
  172. %-----------------------------------------------------------------------------------------
  173. /tt{gsave currentpoint 2 copy 2t aload pop qa 2    copy xl    3a aload pop exch dup 0    eq
  174. {pop}{1    eq{-1 1}{1 -1}ifelse scale}ifelse rotate pop neg exch neg exch xl moveto}def
  175.  
  176. /te{currentpoint currentfont grestore setfont moveto}def
  177. /tb{/tg    currentgray def    3 -1 roll 3 eq{1 setgray}if /ml    0 def /al 0 def}def
  178. /am{ml add /ml xdf}def
  179. /aa{[currentgray /setgray cvx]cvx exch dup wi pop dup al add /al xdf exch}def
  180.  
  181. %-----------------------------------------------------------------------------------------
  182. % scale    coordinate system by numerator denominator pairs:
  183. % denominator(vertical,horizontal) numerator(vertical,horizontal)
  184. %-----------------------------------------------------------------------------------------
  185. /th{3 -1 roll div 3 1 roll exch    div 2 copy mx1 scale pop scale /scaleflag true def}def
  186. /tu{1 1    mx1 itransform scale /scaleflag    false def}def
  187. /ts{1 1    mx1 transform scale /scaleflag true def}def
  188.  
  189. %-----------------------------------------------------------------------------------------
  190. % fontsize: pointsize
  191. %-----------------------------------------------------------------------------------------
  192. /fz{/ps    xdf}def
  193.  
  194. %-----------------------------------------------------------------------------------------
  195. % execute a procedure but leave    procedure on stack
  196. % {proc}fx
  197. %-----------------------------------------------------------------------------------------
  198. /fx{dup    exec}def
  199.  
  200. /st{show pop pop}def
  201.  
  202. %-----------------------------------------------------------------------------------------
  203. % These    procedures constitute string merging.
  204. %-----------------------------------------------------------------------------------------
  205. /tm{
  206.       {
  207.       dup type dup /integertype    eq exch    /realtype eq or
  208.          {
  209.          dup ml    mul
  210.          }
  211.          {
  212.          dup type /stringtype eq
  213.             {
  214.             rs
  215.             }
  216.             {
  217.             dup    type /dicttype eq
  218.                {
  219.                setfont
  220.                }
  221.                {
  222.                dup type    /arraytype eq
  223.                   {
  224.                   exec
  225.                   }
  226.                   {
  227.                   pop
  228.                   }ifelse
  229.                }ifelse
  230.             }ifelse
  231.          }ifelse
  232.       }forall
  233.    }def
  234. %-----------------------------------------------------------------------------------------
  235. % textFace textmode justification-type [array-of-strings-and-font-changes] es
  236. %-----------------------------------------------------------------------------------------
  237. /es{
  238.    3 -1    roll dup sa 5 get dup type /nulltype eq
  239.    {pop4 pop}
  240.    {
  241.    sa 1    get {/ml ml .2 ps mul sub def}if  %Italic Hack Hack Hack
  242.       ne{fs}{pop}ifelse    exch
  243.       dup 1 eq
  244.  %left justification
  245.       {pop
  246.          al ml gt{/tv{ll}/ml ml    al dup 0 ne{div}{pop}ifelse def}{/tv{st}/ml 1 def}ifelse def
  247.          tm
  248.       }
  249.       {
  250.       dup 3 eq
  251.  %right    justification
  252.       {pop
  253.       al ml gt{/tv{ll}/ml ml al    dup 0 ne{div}{pop}ifelse def}{ml al sub    0 rmoveto /tv{st}/ml 1 def}ifelse def
  254.          tm
  255.       }
  256.       {
  257.       2    eq
  258.    %center justification
  259.       {
  260.       al ml gt{/tv{ll}/ml ml al    dup 0 ne{div}{pop}ifelse def}{ml al sub    2 div 0    rmoveto    /tv{st}/ml 1 def}ifelse    def
  261.          tm
  262.       }
  263.       {
  264.    %full justification
  265.       /tv{ll}def
  266.       /ml ml al    dup 0 ne{div}{pop}ifelse def
  267.          tm
  268.       }ifelse}ifelse}ifelse
  269.       }ifelse
  270.    tg setgray
  271. }def
  272.  
  273. /pop4 {pop pop pop pop}    def
  274.  
  275. %-----------------------------------------------------------------------------------------
  276. % The QuickDraw    Procedures
  277. %-----------------------------------------------------------------------------------------
  278. %-----------------------------------------------------------------------------------------
  279. % moveto: x y
  280. %-----------------------------------------------------------------------------------------
  281. /gm{scaleflag{mx1 itransform}if    moveto}def
  282. %local ymove: x    y ly
  283. /ly{exch pop currentpoint exch pop sub 0 exch rmoveto}def
  284.  
  285. %-----------------------------------------------------------------------------------------
  286. % print    n copies of page  (ensures 8 pages/minute for multiple copies)
  287. %-----------------------------------------------------------------------------------------
  288. /page{1    add /#copies xdf showpage}def
  289.  
  290. /sk{systemdict /statusdict known}def
  291.  
  292. %-----------------------------------------------------------------------------------------
  293. % set jobname (string)
  294. %-----------------------------------------------------------------------------------------
  295. /jn{sk{statusdict /jobname 3 -1    roll put}{pop}ifelse}def
  296.  
  297. %-----------------------------------------------------------------------------------------
  298. % set pen size:    h v pen
  299. %-----------------------------------------------------------------------------------------
  300. /pen {/pnsv xdf    /pnsh xdf pnsh setlinewidth} def
  301.  
  302. %-----------------------------------------------------------------------------------------
  303. % lineto procedures: x y
  304. % (uses    current    pen location, pen size and graylevel)
  305. % This really emulates the ugly    QuickDraw pen on the LaserWriter but preserves the same
  306. % endpoint and linewidth anomalies that    some applications rely on.
  307. %-----------------------------------------------------------------------------------------
  308. /dlin{currentpoint newpath moveto lineto currentpoint stroke grestore moveto}def
  309. /lin {currentpoint /pnlv xdf /pnlh xdf gsave newpath /@y xdf /@x xdf fp{pnlh @x    lt {pnlv @y ge
  310. {pnlh pnlv moveto @x @y    lineto pnsh 0 rlineto
  311. 0 pnsv rlineto pnlh pnsh add pnlv pnsv add lineto pnsh neg 0 rlineto}
  312. {pnlh pnlv moveto pnsh 0 rlineto @x pnsh add @y    lineto 0 pnsv rlineto
  313. pnsh neg 0 rlineto pnlh    pnlv pnsv add lineto} ifelse} {pnlv @y gt
  314. {@x @y moveto pnsh 0 rlineto pnlh pnsh add pnlv    lineto 0 pnsv rlineto
  315. pnsh neg 0 rlineto @x @y pnsv add lineto} {pnlh    pnlv moveto pnsh 0 rlineto
  316. 0 pnsv rlineto @x pnsh add @y pnsv add lineto pnsh neg 0 rlineto
  317. 0 pnsv neg rlineto} ifelse} ifelse
  318. closepath fill}if @x @y    grestore moveto} def
  319. /dl{gsave 0 setlinewidth 0 setgray}def
  320.  
  321. %-----------------------------------------------------------------------------------------
  322. % Arc:    top left bottom    right startangle stopangle verb    flag
  323. % flag means to    exclude    the center of curvature    in the arc
  324. %-----------------------------------------------------------------------------------------
  325. /barc {/@f xdf /@op xdf    /@e xdf    /@s xdf    /@r xdf
  326. /@b xdf    /@l xdf    /@t xdf    gsave
  327. @r @l add 2 div    @b @t add 2 div    xl 0 0 moveto
  328. @r @l sub @b @t    sub mtx    currentmatrix pop scale    @f {newpath} if
  329. 0 0 0.5    @s @e arc
  330. mtx setmatrix @op doop grestore} def
  331. /doarc {dup 0 eq barc} def
  332.  
  333. %-----------------------------------------------------------------------------------------
  334. % oval:     top left bottom right verb
  335. %-----------------------------------------------------------------------------------------
  336. /doval {0 exch 360 exch    true barc} def
  337.  
  338. %-----------------------------------------------------------------------------------------
  339. % rectangle:  top left bottom right verb
  340. /dorect    {/@op xdf currentpoint 6 2 roll    newpath    4 copy
  341. 4 2 roll exch moveto 6 -1 roll lineto lineto lineto closepath
  342. @op doop moveto} def
  343. /mup{dup pnsh 2    div le exch pnsv 2 div le or}def
  344.  
  345. %-----------------------------------------------------------------------------------------
  346. % roundrect:  top left bottom right ovalwidth ovalheight operation
  347. % Caveat: ovalwidth is currently assumed equal to ovalheight
  348. %-----------------------------------------------------------------------------------------
  349. /dorrect {/@op xdf 2. div /@h xdf 2. div /@w xdf
  350. /@r xdf    /@b xdf    /@l xdf    /@t xdf
  351. @t @b eq @l @r eq @w mup or or{@t @l @b    @r @op dorect}
  352.    {
  353.    @r @l sub 2.    div dup    @w lt{/@w xdf}{pop}ifelse
  354.    @b @t sub 2.    div dup    @w lt{/@w xdf}{pop}ifelse
  355.    @op 0 eq{/@w    @w pnsh    2 div sub def}if    %this helps    solve overlap gap for wide line    widths
  356.    currentpoint
  357.    newpath
  358.    @r @l add 2.    div @t moveto
  359.    @r @t @r @b @w arcto    pop4
  360.    @r @b @l @b @w arcto    pop4
  361.    @l @b @l @t @w arcto    pop4
  362.    @l @t @r @t @w arcto    pop4
  363.    closepath @op doop
  364.    moveto
  365.    }ifelse
  366. } def
  367.  
  368. %-----------------------------------------------------------------------------------------
  369. % Polygon utility procedures
  370. %-----------------------------------------------------------------------------------------
  371. /pr{gsave newpath /pl{moveto /pl{lineto}def}def}def
  372. /pl{lineto}def
  373. /ep{dup    0 eq
  374.    {
  375.    {moveto}{lin}{}{}pathforall    %nothing but movetos and linetos should    be called
  376.    pop grestore
  377.    }
  378.    {
  379.    doop    grestore
  380.    }ifelse
  381. }def
  382. /bs 8 string def
  383. /bd{/bs    xdf}def
  384.  
  385. %-----------------------------------------------------------------------------------------
  386. % These    following procedures are used in defining QuickDraw patterns.
  387. % Pattern definition goes into halftone    screen of PostScript
  388. %-----------------------------------------------------------------------------------------
  389. % procedure to find black bits in QuickDraw pattern (pattern in    hex string bs)
  390. /bit {bs exch get exch 7 sub bitshift 1    and} def
  391. /bix {1    add 4 mul cvi} def
  392. /pp{exch bix exch bix bit}def
  393. /grlevel {64. div setgray} def
  394.  
  395. %-----------------------------------------------------------------------------------------
  396. % procedure to set a pattern: ratio hexstring
  397. % ratio    is the total number of white bits in the QuickDraw pattern represented in hexstring
  398. %-----------------------------------------------------------------------------------------
  399. /setpat    {/bs xdf 9.375 0{pp}setscreen grlevel} def
  400. /setgry    {freq rot {spf}    setscreen grlevel} def
  401.  
  402. %-----------------------------------------------------------------------------------------
  403. % standard copybits routine: xscale yscale xloc    yloc rowbytes xwidth ywidth fsmooth bitmode
  404. % This procedure is the    basis for all QuickDraw    bit operations.
  405. % xscale and yscale tell how much to scale the bit image in 72nds of an    inch
  406. % xloc and yloc    are the    location of the    top left corner    of the bitmap
  407. % rowbytes is the total    number of bytes    in each    scanline of hex    data in    the image
  408. %    Note that rowbytes    must be    even
  409. % xwidth and ywidth are    the actual number of bits in the x and y coordinates of    the image
  410. % fsmooth is a flag to tell whether or not to use bit smoothing.  Bit smoothing    is a
  411. %    proprietary algorithm that    provides smoothing of the data around a    5 by 5 local area of each
  412. %    data pixel.
  413. % bitmode can be any of    the QuickDraw source transfer modes excluding srcXor and notSrcXor
  414. %    Note that this is the only    QuickDraw procedure which can implement    more than the simple
  415. %    srcCopy transfer mode.
  416. %-----------------------------------------------------------------------------------------l
  417. /x4 {2 bitshift} def
  418. /d4 {-2    bitshift} def
  419. /xf {.96 mul exch 2 sub    .96 mul    exch} def
  420. /dobits
  421. {
  422. /bmode xdf
  423. save 9 1 roll
  424. % 2 sub    fixes dxsrc offset number required for bitsmoothing, but applies to both
  425. %Bit Smooth mode
  426.    {
  427.    x4 /@dy xdf 2 sub x4    /@dx xdf /@idx xdf
  428.    .96 mul exch    3 index    2 sub @dx div 7.68 mul dup 6 1 roll sub    exch xl    0 0 moveto xf
  429.    0 4 -1 roll 2 index 4 index 1.759 add 10 dorect clip    newpath    0 0 moveto scale
  430.    bmode 0 eq bmode 4 eq or{1 setgray 1    @dy div    1 @dx div 1 1 2    dorect}if
  431.    bmode 3 eq bmode 7 eq or{1}{0}ifelse    setgray
  432.    @idx    5 bitshift @dy bmode 0 eq bmode    1 eq bmode 3 eq    or or [@dx 0 0 @dy 0 0]
  433.      {(%stdin)(r) file @dy d4 4    add @idx mul string readhexstring pop
  434.      dup length    @idx x4    sub 4 bitshift string
  435.      dup 3 1 roll @dx 8    add d4 smooth} imagemask
  436.    }
  437. %Non Bit Smooth    mode
  438.    {
  439.    /@dy    xdf 2 sub /@dx xdf /@idx xdf
  440.    /@xs    @idx string def
  441.    /@f (%stdin)(r) file    def
  442.    /@p{@f @xs readhexstring pop}def
  443.    .96 mul xl 0    0 moveto xf scale
  444.    0 0 1 1 10 dorect clip newpath 0 0 moveto
  445.    bmode 0 eq bmode 4 eq or{1 setgray .25 @dy div .25 @dx div 1    1 2 dorect}if
  446.    bmode 3 eq bmode 7 eq or{1}{0}ifelse    setgray
  447.    @p @p
  448.    @idx    3 bitshift @dy bmode 0 eq bmode    1 eq bmode 3 eq    or or [@dx 0 0 @dy 0 0]
  449.    {@p}    imagemask
  450.    @p @p pop4
  451.    }ifelse
  452. restore
  453. } def
  454.  
  455. %-----------------------------------------------------------------------------------------
  456. % Making Mac compatible    Fonts
  457. %-----------------------------------------------------------------------------------------
  458.  
  459. /mfont 14 dict def
  460. /wd 14 dict def
  461. /mdef {mfont wcheck not{/mfont 14 dict def}if mfont begin xdf end} def
  462. /dc {transform round .5    sub exch round .5 sub exch itransform} def
  463.  
  464. %-----------------------------------------------------------------------------------------
  465. % Copy a font dictionary: fontdictionary
  466. % copies a font    dictionary into    tmp so it may be used to define    a new font
  467. %-----------------------------------------------------------------------------------------
  468. % tmp must be set before cf is called
  469. /cf{{1 index /FID ne {tmp 3 1 roll put}{pop pop}ifelse}forall}def
  470.  
  471. %-----------------------------------------------------------------------------------------
  472. % Procedures used in defining a    bit map    font
  473. %-----------------------------------------------------------------------------------------
  474. /mv{tmp    /Encoding macvec put}def
  475. /bf{
  476. mfont begin
  477. /FontType 3 def
  478. /FontMatrix [1 0 0 1 0 0] def
  479. /FontBBox [0 0 1 1] def
  480. /Encoding macvec def
  481. /BuildChar
  482.   {
  483.   wd begin
  484.     /cr    xdf
  485.     /fd    xdf
  486.     fd /low get    cr get 2 get -1    ne
  487.     {
  488.     fd begin
  489.       low cr get aload pop
  490.       sd
  491.       low cr 1 add get 0 get
  492.       sh
  493.       sw
  494.     end
  495.     /sw    xdf
  496.     /sh    xdf
  497.     sw div /clocn xdf
  498.     dup    0 ne {0    exch sh    div neg    dc xl}{pop}ifelse
  499.     exch sw div    /coff xdf
  500.     exch sw div    /cloc xdf
  501.     /bitw clocn    cloc sub def
  502.     sw sh div 1    scale
  503.     sw div 0 coff 0 bitw coff add 1 setcachedevice
  504.     coff cloc sub 0 dc xl
  505.     cloc .5 sw div add 0 dc newpath moveto
  506.     bitw 0 ne
  507.       {0 1 rlineto bitw    .5 sw div sub 0    rlineto    0 -1 rlineto
  508.         closepath clip
  509.       sw sh false [sw 0    0 sh neg 0 sh]{fd /hm get}imagemask}if
  510.     } if
  511.   end
  512.   } def
  513. end
  514. mfont definefont pop
  515. } def
  516.  
  517. %-----------------------------------------------------------------------------------------
  518. % stringwidth procedure    which does not allow a show to occur: (string)
  519. %-----------------------------------------------------------------------------------------
  520. /wi{save exch /show{pop}def
  521. stringwidth 3 -1 roll restore}def
  522.  
  523. /aps {0    get 124    eq}def
  524. /apn {s30 cvs aps} def
  525.  
  526. %-----------------------------------------------------------------------------------------
  527. %set style in a    PostScript name: AppleFontName
  528. % e.g.
  529. % /|----name sos /|---Oname
  530. % /|----name sis /|-I--name
  531. %-----------------------------------------------------------------------------------------
  532. /xc{s30    cvs dup}def
  533. /xp{put    cvn}def
  534. /scs{xc    3 67 put dup 0 95 xp}def
  535. /sos{xc    3 79 xp}def
  536. /sbs{xc    1 66 xp}def
  537. /sis{xc    2 73 xp}def
  538. /sob{xc    2 79 xp}def
  539. /sss{xc    4 83 xp}def
  540.  
  541. /dd{exch 1 index add 3 1 roll add exch}    def
  542. /smc{moveto dup    show} def
  543. /kwn{dup FontDirectory exch known{findfont exch    pop}}def
  544. /fb{/ps    ps 1 add def}def
  545. /mb
  546. {dup sbs kwn
  547.    {
  548.    exch{pop}{bbc}{} mm
  549.    }ifelse
  550. sfd
  551. }def
  552. /mo
  553. {dup sos kwn
  554.    {
  555.    exch{pop}{boc}{} mm
  556.    }ifelse
  557. sfd
  558. }def
  559. /ms
  560. {dup sss kwn
  561.    {
  562.    exch{pop}{bsc}{} mm
  563.    }ifelse
  564. sfd
  565. }def
  566. /ao
  567. {dup sos kwn
  568.    {
  569.    exch    dup ac pop
  570.    {scs    findfont /df2 xdf}{aoc}{} mm
  571.    }ifelse
  572. sfd
  573. }def
  574. /as
  575. {dup sss kwn
  576.    {
  577.    exch    dup ac pop
  578.    {scs    findfont /df2 xdf}{asc}{} mm
  579.    }ifelse
  580. sfd
  581. }def
  582. /ac
  583.    {
  584.    dup scs kwn
  585.       {exch /ofd exch findfont def
  586.       /tmp ofd maxlength 1 add dict def
  587.       ofd cf mv
  588.       tmp /PaintType 1 put
  589.       tmp definefont}ifelse
  590.    }def
  591. /mm{
  592. /mfont 10 dict def
  593. mfont begin
  594. /FontMatrix [1 0 0 1 0 0] def
  595. /FontType 3 def
  596. /Encoding macvec def
  597. /df 4 index findfont def
  598. /FontBBox [0 0 1 1] def
  599. /xda xdf
  600. /mbc xdf
  601. /BuildChar { wd    begin
  602.   /cr xdf
  603.   /fd xdf
  604.   /cs s1 dup 0 cr put def
  605.   fd /mbc get exec
  606.   end
  607. } def
  608. exec
  609. end
  610. mfont definefont} def
  611. /bbc
  612. {
  613.   /da .03 def
  614.   fd /df get setfont
  615.   gsave
  616.     cs wi exch da add exchd
  617.   grestore
  618.   setcharwidth
  619.   cs 0    0 smc
  620.     da    0 smc
  621.     da da smc
  622.      0 da moveto show
  623. } def
  624. /boc
  625. {
  626.   /da 1    ps div def
  627.   fd /df get setfont
  628.   gsave
  629.     cs wi
  630.     exch da add    exch
  631.   grestore
  632.   setcharwidth
  633.   cs 0    0 smc
  634.     da    0 smc
  635.     da da smc
  636.      0 da smc
  637.   1 setgray
  638.      da    2. div dup moveto show
  639. } def
  640. /bsc
  641. {
  642.   /da 1    ps div def
  643.   /ds .05 def %da dup .03 lt {pop .03}if def
  644.   /da2 da 2. div def
  645.   fd /df get setfont
  646.   gsave
  647.     cs wi
  648.     exch ds add    da2 add    exch
  649.   grestore
  650.   setcharwidth
  651.   cs ds    da2 add    .01 add    0 smc
  652.       0    ds da2 sub xl
  653.       0     0 smc
  654.      da     0 smc
  655.      da    da smc
  656.       0    da smc
  657.   1 setgray
  658.       da 2. div    dup moveto show
  659. } def
  660. /aoc
  661. {
  662.   fd /df get setfont
  663.   gsave
  664.     cs wi
  665.   grestore
  666.   setcharwidth
  667.   1 setgray
  668.   cs 0 0 smc
  669.   fd /df2 get setfont
  670.   0 setgray
  671.   0 0 moveto show
  672. }def
  673. /asc
  674. {
  675.   /da .05 def
  676.   fd /df get setfont
  677.   gsave
  678.     cs wi
  679.     exch da add    exch
  680.   grestore
  681.   setcharwidth
  682.   cs da    .01 add    0 smc
  683.       0    da xl
  684.   1 setgray
  685.       0    0 smc
  686.   0 setgray
  687.   fd /df2 get setfont
  688.       0    0 moveto show
  689. }def
  690.  
  691. %-----------------------------------------------------------------------------------------
  692. % Procedure to print instruction sheet and set up manual feed
  693. %-----------------------------------------------------------------------------------------
  694. /mf{gsave
  695. 32 760 xl 1 -1 scale
  696. 1 1 pen
  697. 128 152    moveto
  698. 27.5 27.5 693.5    522.5 0    dorect
  699. 6 6 pen
  700. 63. 63.    657. 486. 0 dorect
  701. 48 fz F    /|B---1Times fnt pop
  702. (Manual    Feed)show
  703. 118 275    moveto
  704. 14 fz F    /|----1Times fnt pop
  705. (document: )show
  706. sk{statusdict /jobname get dup null ne{show}{pop}ifelse}if
  707. %(")show
  708. 118 362    moveto
  709. (Manual    Feed Instructions)show
  710. 127 398    moveto
  711. (1.  Wait until    the yellow light on the    front of your)show
  712. 145 416    moveto
  713. (LaserWriter comes on steadily \5C(not flashing\5C).)show
  714. 127 458    moveto
  715. (2.  Insert your paper or envelope in the manual feed)show
  716. 145 478    moveto
  717. (guide on the right side of the    LaserWriter.)show
  718. 127 517    moveto
  719. (3.  Repeat steps 1 and    2 until    your document is)show
  720. 145 537    moveto
  721. (completed.)show
  722. 0 page
  723. sk{statusdict /manualfeed true put 5 dly}if
  724. grestore}def
  725. /dly{
  726. usertime exch 1000 mul add
  727.    {
  728.    dup usertime    le{exit}if
  729.    }loop
  730. pop
  731. }def
  732.  
  733. %-----------------------------------------------------------------------------------------
  734. % List all Apple compatible fonts one name per line
  735. %-----------------------------------------------------------------------------------------
  736. /lsf {FontDirectory {pop dup apn{= flush}{pop}ifelse}forall /* = flush}def
  737.  
  738. /T true    def
  739. /F false def
  740.  
  741. %-----------------------------------------------------------------------------------------
  742. % More Polygon stuff used in polygon comment
  743. %-----------------------------------------------------------------------------------------
  744. /6a 6 array def
  745. /2a 2 array def
  746. /5a 5 array def
  747. %subtract points, first    from second (reverse order):  pt0 pt1 qs newpt
  748. /qs{3 -1 roll sub exch 3 -1 roll sub exch}def
  749. /qa{3 -1 roll add exch 3 -1 roll add exch}def
  750. %multiply point: pt factor qm newpt
  751. /qm{3 -1 roll 1    index mul 3 1 roll mul}def
  752. /qn{6a exch get    mul}def
  753. /qA .166667 def    /qB .833333 def    /qC .5 def
  754. /qx{
  755.    6a astore pop
  756.    qA 0    qn qB 2    qn add     qA 1 qn qB 3 qn add
  757.    qB 2    qn qA 4    qn add     qB 3 qn qA 5 qn add
  758.    qC 2    qn qC 4    qn add     qC 3 qn qC 5 qn add
  759. }def
  760. /qp{6 copy 12 -2 roll pop pop}def
  761. /qc{qp qx curveto}def
  762. /qi{{4 copy 2a astore aload pop    qa .5 qm newpath moveto}{2 copy    6 -2 roll 2 qm qs 4 2 roll}ifelse}def
  763. /qq{{qc    2a aload pop qx    curveto}{4 copy    qs qa qx curveto}ifelse}def
  764. %start polygon comment
  765. /pt{gsave currentpoint newpath moveto}def
  766. %fill smoothed poly
  767. /qf{gsave eofill grestore}def
  768. /tr{currentgray    currentscreen bs 5a astore pop /fillflag 1 def}def
  769. /bc{/fillflag 0    def}def
  770. %polyverb ec
  771. /ec{currentpoint 3 -1 roll
  772.    1 and 0 ne
  773.    {currentgray    currentscreen bs 5a aload pop bd setscreen setgray 0 doop bd setscreen setgray}
  774.    {newpath}ifelse
  775.    moveto
  776. }def
  777. /bp{currentpoint newpath 2 copy    moveto currentgray currentscreen bs 5a astore pop}def
  778. /eu{
  779.    fillflag 0 ne
  780.    {
  781.    gsave currentgray currentscreen bs
  782.    5a aload pop    bd setscreen setgray
  783.    4 ep
  784.    bd setscreen    setgray
  785.    }if
  786.    fp{0    ep}{grestore newpath}ifelse
  787. }def
  788.  
  789. %-----------------------------------------------------------------------------------------
  790. % Line Layout stuff used by string merging algorithm
  791. %-----------------------------------------------------------------------------------------
  792. % counts spaces    in string:   (...) sm (...) n
  793. % returns string and number of spaces in string
  794. %-----------------------------------------------------------------------------------------
  795. /sm
  796. {
  797. dup 0 exch
  798. {32 eq{1 add}if}forall
  799. }
  800. def
  801.  
  802. %-----------------------------------------------------------------------------------------
  803. % layout a string to length specified by desiredlength:     printerlength desiredlength (...) ll
  804. % printerlength    is length of string in printer space
  805. %-----------------------------------------------------------------------------------------
  806. /ll
  807. {
  808. 3 1 roll exch dup .0001    lt 1 index -.0001 gt and
  809. {pop pop pop}
  810. {sub dup 0 eq
  811.    {
  812.    pop show
  813.    }
  814.    {
  815.    1 index sm dup 0 eq 3 index 0 le or
  816.       {
  817.       pop length div
  818.       0    3 -1 roll ashow
  819.       }
  820.       {
  821. % This piece does 10 percent stretching    in characters and 90 percent in    spaces
  822.       10 mul exch length add div
  823.       dup 10 mul 0 32 4    -1 roll    0 6 -1 roll awidthshow
  824. % This piece does straight stretching in spaces    only
  825. %      exch pop    div
  826. %      0 32 4 -1 roll widthshow
  827.       }ifelse
  828.    }ifelse
  829. }ifelse
  830. }def
  831.  
  832. %-----------------------------------------------------------------------------------------
  833. %set font to symbol and    show the string: (...) ss
  834. %-----------------------------------------------------------------------------------------
  835. /ss
  836. {  /pft    currentfont def    sa aload pop pop /|----2Symbol 4 1 roll
  837.    {pop{as}}
  838.    {{{ao}}{{fnt}}ifelse}ifelse
  839.    exch    pop exec exch pop
  840. }def
  841. /pf{pft    dup setfont}def
  842.  
  843. %-----------------------------------------------------------------------------------------
  844. % regular show does underline if ulf is    true: printerlength desiredlength string rs
  845. %-----------------------------------------------------------------------------------------
  846. /rs
  847. {
  848.    sa 2    get
  849.    {
  850.    gsave
  851.    1 index 0
  852.    currentfont
  853.    dup /FontInfo known
  854.       {
  855.       /FontInfo    get
  856.       dup /UnderlinePosition known
  857.          {
  858.          dup /UnderlinePosition    get 1000 div ps    mul
  859.          }
  860.          {
  861.          ps 10 div neg     %15 makes line    closer to text
  862.          }ifelse
  863.       exch
  864.       dup /UnderlineThickness known
  865.          {
  866.          /UnderlineThickness get 1000 div ps mul
  867.          }
  868.          {
  869.          pop
  870.          ps 15 div     %20 makes slightly narrower line
  871.          }ifelse
  872.       }
  873.       {
  874.       pop
  875.       ps 10 div    neg   %15 makes    line closer to text
  876.       ps 15 div          %20 makes    slightly narrower line
  877.       }ifelse
  878.    setlinewidth
  879.    0 setgray
  880.    currentpoint    3 -1 roll sub moveto
  881.    sa 4    get{gsave currentlinewidth 2. div dup rmoveto currentpoint xl 2    copy rlineto
  882.    stroke grestore}if
  883.    sa 3    get sa 4 get or    3 1 roll 2 index{gsave 1 setgray 2 copy    rlineto    stroke grestore}if
  884.    rlineto{strokepath 0    setlinewidth}if    stroke
  885.    grestore
  886.    }if
  887.    tv
  888. }
  889. def
  890.  
  891. %-----------------------------------------------------------------------------------------
  892. %  More    Font building stuff, specifically the Apple Encoding Vector
  893. %-----------------------------------------------------------------------------------------
  894. % Font encoding    vector for PostScript fonts to match Mac
  895. /macvec    256 array def
  896. macvec 0
  897. /Times-Roman findfont /Encoding    get
  898. 0 128 getinterval putinterval macvec 39    /quotesingle put
  899.  /dotlessi /grave /circumflex /tilde /cedilla /registerserif /copyrightserif /trademarkserif
  900. macvec 0 8 getinterval astore pop
  901.  /Adieresis /Aring /Ccedilla /Eacute /Ntilde /Odieresis    /Udieresis /aacute
  902.  /agrave /acircumflex /adieresis /atilde /aring    /ccedilla /eacute /egrave
  903.  /ecircumflex /edieresis /iacute /igrave /icircumflex /idieresis /ntilde /oacute
  904.  /ograve /ocircumflex /odieresis /otilde /uacute /ugrave /ucircumflex /udieresis
  905.  /dagger /ring /cent /sterling /section    /bullet    /paragraph /germandbls
  906.  /registersans /copyrightsans /trademarksans /acute /dieresis /notequal    /AE /Oslash
  907.  /infinity /plusminus /lessequal /greaterequal /yen /mu    /partialdiff /summation
  908.  /product /pi /integral    /ordfeminine /ordmasculine /Omega /ae /oslash
  909.  /questiondown /exclamdown /logicalnot /radical    /florin    /approxequal /Delta /guillemotleft
  910.  /guillemotright /ellipsis /space /Agrave /Atilde /Otilde /OE /oe
  911.  /endash /emdash /quotedblleft /quotedblright /quoteleft /quoteright /divide /lozenge
  912.  /ydieresis /Ydieresis /fraction /currency /guilsinglleft /guilsinglright /fi /fl
  913.  /daggerdbl /periodcentered /quotesinglbase /quotedblbase /perthousand /Acircumflex /Ecircumflex /Aacute
  914.  /Edieresis /Egrave /Iacute /Icircumflex /Idieresis /Igrave /Oacute /Ocircumflex
  915.  /apple    /Ograve    /Uacute    /Ucircumflex /Ugrave /dotlessi /asciicircum /asciitilde
  916.  /macron /breve    /dotaccent /ring /cedilla /hungarumlaut    /ogonek    /caron
  917. macvec 128 128 getinterval astore pop
  918.  
  919. %-----------------------------------------------------------------------------------------
  920. % now redefine all fonts using the MAC Encoding    (except    in Symbol) to make them
  921. % Apple    compatible.
  922. %-----------------------------------------------------------------------------------------
  923. FontDirectory
  924. {exch dup s30 cvs /@s xdf @s aps
  925.    {pop    pop}
  926.    {exch dup length dict /tmp xdf
  927.       cf
  928.       /Symbol ne {mv} if
  929.       /@i false    def /@o    false def /@b false def
  930.       mark @s (Italic) search {/@i true    def} if    (Oblique) search {/@o true def}    if
  931.       (Bold) search {/@b true def} if (Roman) search pop (-) search pop    /@s xdf    cleartomark
  932.       @s cvn dup /Symbol eq{pop    50}{/Courier eq{51}{49}ifelse}ifelse
  933.       s30 0 @s length 6    add getinterval    dup 6 @s putinterval dup 0 (|-----) putinterval
  934.       @b {dup 1    66 put}    if @i @o or {dup 2 73 put} if %    @o {dup    2 79 put} if
  935.       dup 5 4 -1 roll put
  936.       cvn tmp definefont pop
  937.    }ifelse
  938. }forall
  939.  
  940. %-----------------------------------------------------------------------------------------
  941. %Make any other    special    fonts here, i.e. Seattle
  942. %-----------------------------------------------------------------------------------------
  943. /_--C-2Symbol /Symbol findfont /tmp 1 index maxlength 1    add dict def cf    tmp /PaintType 1 put tmp definefont
  944. /|----4Seattle /Helvetica findfont dup length 1    add dict /tmp xdf cf mv
  945. /mxv [/zero /one /two /three /four /five /six /seven /eight /nine /comma /period /dollar /numbersign
  946. /percent /plus /hyphen /E /parenleft /parenright /space] def
  947. tmp /Metrics 21    dict dup begin mxv{600 def}forall end put
  948. tmp begin /FontBBox FontBBox [0    0 0 0] astore def end
  949. tmp definefont pop
  950.  
  951. %-----------------------------------------------------------------------------------------
  952. % open document, open page and close page procedures
  953. % close    document doesn't do anything currently
  954. %-----------------------------------------------------------------------------------------
  955. % txpose takes the vertical page size as a parameter
  956. /od{txpose 10 fz 0 fs F    /|----3Courier fnt pop}def
  957. /op{/scaleflag false def /pm save def}def
  958. /cp{pm restore}def
  959.  
  960. end
  961.  
  962.